home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pnl010.zip
/
DIGISND.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-03-01
|
3KB
|
135 lines
(*------------------------------------------*)
(* Unit DIGISND *)
(* by Alex Boisvert, March 1992 *)
(*------------------------------------------*)
(* For use with RESPLAY v1.0 *)
(* Distribute freely! *)
(*------------------------------------------*)
unit DigiSnd;
interface
uses dos,crt;
type
arrptr=array[1..10] of pointer;
ResplayObject = object
SoundPtr : array [1..10] of pointer;
SoundRegs : registers;
SoundNum,
SoundMax : integer;
EntireFileLoaded : boolean;
SoundFile : file;
SoundSize : longint;
constructor Init;
function Setup(Mode, OutKind, Speed : integer) : boolean;
procedure Load(SoundFileName : string);
procedure Play;
destructor Done;
end;
implementation
constructor ResplayObject.Init;
begin
SoundNum := 0;
SoundMax := 0;
SoundSize := 0;
end;
function ResplayObject.Setup(Mode, OutKind, Speed : integer) : boolean;
begin
{check if Resplay is loaded}
with SoundRegs do begin
AX := $8201;
Intr($2f,SoundRegs);
if AX <> $7746 then begin
Setup := false;
exit;
end;
end;
{check if setup is correct}
with SoundRegs do begin
AX := $8210;
CL := Mode;
BL := OutKind;
BH := Speed;
Intr($2f,SoundRegs);
if AX <> 4096 then Setup := false
else Setup := true;
end;
end; { setup }
procedure ResplayObject.Load(SoundFileName : string);
Var SoundCount : integer;
ByteRead : word;
TempFile : file of byte;
begin
{get size of file}
Assign(TempFile, SoundFileName);
Reset(TempFile);
SoundSize := FileSize(TempFile);
Close(TempFile);
{read file}
Assign(SoundFile, SoundFileName);
Reset(SoundFile);
{get total available memory - except 40k for Turbo Pascal}
SoundMax := Trunc((MaxAvail-40000)/65535);
SoundNum := 0;
repeat
Inc(SoundNum);
GetMem(SoundPtr[SoundNum],65535);
BlockRead(SoundFile, SoundPtr[SoundNum]^, 65535, ByteRead);
until (ByteRead=0) or (SoundNum=SoundMax);
if (SoundNum=SoundMax) and (ByteRead <> 0) then EntireFileLoaded := false
else begin
EntireFileLoaded := true;
Dec(SoundNum);
end;
Close(SoundFile);
end;
procedure ResplayObject.Play;
var SoundCount : integer;
procedure PlaySoundSeg( MemSeg : pointer; SegSize : longint);
begin
with SoundRegs do begin
AX := $8200;
DX := Seg(MemSeg^);
DI := Ofs(MemSeg^);
CX := Trunc(SegSize/65536);
BX := SegSize - Trunc(CX * SegSize/65536);
end;
Intr($2f,SoundRegs);
If SoundRegs.AX = $2000 then begin
WriteLn('Complete Failure!');
Sound(1000);
Delay(500);
NoSound;
Halt(1);
end;
end;
begin
{play each allocated pointer}
if (SoundNum = 1) then PlaySoundSeg(SoundPtr[1], SoundSize)
else begin
For SoundCount := 1 to SoundNum-1 do PlaySoundSeg(SoundPtr[SoundCount],65535);
if not EntireFileLoaded then PlaySoundSeg(SoundPtr[SoundNum], 65535)
else PlaySoundSeg(SoundPtr[SoundNum], SoundSize-(SoundNum-1)*65535);
end;
end;
destructor ResplayObject.Done;
var SoundCount : Integer;
begin
For SoundCount :=1 to SoundNum do FreeMem(SoundPtr[SoundCount],65535);
end;
end. {unit}